#!/usr/bin/perl

# Copyright (C) 2010 Ryan O'Horo <aydiosmio near gmail dot com>
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#

################################################################################
# rblspy - Irssi script
#
# Checks a list of DNSRBLs for hosts that join a channel. If that host matches,
# the match can be announced to the channel, reported to the client or that host
# is automatically banned with a short knockout to prevent filling the banlist.
# This script is designed to assist in managing abuse from anonymous proxies.
#
#	Does not support IPv6 addresses.
# Does not discriminate against varying RBL responses.
#
# Commands
#
# rblban		Set a ban for the last matched nick
# rbllast		Print last match
# rblset		Print or change a script setting /rblset setting value
#
# See settings below.


use strict;

use vars qw($VERSION %IRSSI);
use Socket;
use POSIX;
use Irssi;

$VERSION = "0.4.3";
%IRSSI = (
	authors     => "Ryan O\'Horo",
	contact     => "aydiosmio\@gmail.com",
	name        => "rblspy",
	description => "DNSRBL-based IRC abuse management",
	changed     => "20101128",
	license     => "GNU GPL v2",
	url         => "http://code.google.com/p/rblspy/"
);


################################################################################
# Settings

# Setting @rbls
# Array of reverse-dotted DNSRBL servers
my @rbls = ("torexit.dan.me.uk","tor.dnsbl.sectoor.de","opm.tornevall.org");

my %settings = ();

# Setting autoban
# 0 Do not ban any blacklisted hosts
# 1 Ban blacklisted hosts
$settings{'autoban'} = 0;

# Setting announce
# 0 Indicate blacklisted hosts to the client only
# 1 Indicate blacklisted hosts to the channel
$settings{'announce'} = 0;

# Setting decodeip
# CGI:IRC and other similar web clients will usually encode the remote user IP
# in the user field. This setting attempts to decode the user field and check
# the matching host. Option 2 adds a slight lag to join notifications for a
# reverse lookup.
# 0 Do not attempt to decode username IP
# 1 Attempt to decode username IP
# 2 Attempt to decode username IP and display it to the client
# 3 Attempt to decode username IP and announce it to the channel
$settings{'decodeip'} = 2;

# Setting linedelay
# If an indication to the channel is made before time elapses, 
# it is sent to the client and labeled "Deferred"
# n Seconds between channel announcements
$settings{'linedelay'} = 4;

# Setting $key
# Password for privmesg commands, "" disables remote commands
my $key = "password";


# Globals
my $globalline = 0;				# Counter avoids flood protection triggers
my $lastmatchnick = "";
my $lastmatchip;
my $lasttime = 0;
my $outline = "No blacklisted hosts in history.";


################################################################################
# Load banner

Irssi::active_win->print("rblspy - v" . $VERSION);
Irssi::active_win->print("Lists: " . join(", ",@rbls));


################################################################################
# Functions

sub event_message_join ($$$$) {
	
	my ($server, $channel, $nick, $address) = @_;
	my ($user, $host) = split("@",$address);
	my $witem = Irssi::window_item_find($channel);	
	if (!$witem) { $witem = Irssi::active_win(); }
		
	my $packed = inet_aton($host);
	my $nlen = length($packed);
	
	if ($nlen > 0) {

		my $ipaddress = inet_ntoa($packed);
		$ipaddress =~ /\d+\.\d+\.\d+\.\d+/;

		# Fork the async process for DNS resolution
		# The callback for this is rblspy_join
		my @argref = ($ipaddress, $nick, $channel);
		rblspy_asyncrblcheck(\@argref, \&rblspy_join);

		# Hex IP decode/check
		if ($settings{'decodeip'} >= 1) {
			$user =~ s/^~//;
			if ($user =~ /([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})/) {
				$ipaddress = join(".",hex($1),hex($2),hex($3),hex($4));
				if ($settings{'decodeip'} >= 2) {
					my $afip = inet_aton($ipaddress);
					my $hostname = gethostbyaddr($afip, AF_INET);
					if ($settings{'decodeip'} == 2) {
						$witem->print("Decoded $nick $ipaddress ($hostname)");
					} elsif ($settings{'decodeip'} >= 3) {
						$witem->command("/say $nick $ipaddress ($hostname)");
					}
				}
				@argref = ($ipaddress, $nick, $channel);
				rblspy_asyncrblcheck(\@argref, \&rblspy_join);
			}
		}
	} else {
		$witem->print("Couldn't resolve hostname");
	}

}


sub event_private_message ($$$$) {
	
	my ($server, $msg, $nick, $address) = @_;
	
	# Remote commands
	if (($key ne "") && ($msg =~ /^$key/)) {
		Irssi::active_win->print("Got PRIVMESG from $nick > $msg");
		my @command = split(/ /, $msg);
		if ($command[1] =~ /rbllast/) {
			rblspy_last();
		}
		if ($command[1] =~ /rblban/) {
			rblspy_ban();
		}
	}
	
}


sub rblspy_asyncrblcheck ($$) {

	my ($argref, $callback) = @_;
	my ($pid, $enc, $read, $write);
	my ($ipaddress, $nick, $channel) = @{$argref};

	pipe($read, $write);

	$pid = fork;
	
	if($pid > 0) {
		
		my ($ptag, @args);

		close $write;
		Irssi::pidwait_add($pid);

		@args = ($read, \$ptag, $callback, $argref);
		$ptag  = Irssi::input_add(fileno($read), INPUT_READ, \&rblspy_pipeinput, \@args);

	} else {

		eval {
			
			# Cycle through the RBL list checking for valid host resolutions
			foreach my $rbl (@rbls) {
	
				my $rblhost = join(".", reverse(split(/\./, $ipaddress)));
				$rblhost = $rblhost . "." . $rbl;
				
				my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rblhost);
				if (@addrs) {
					print $write join(".", reverse(split(/\./, inet_ntoa($addrs[0])))) . "." . $rbl . "\n";
					last;
				}
			}
			print $write "";
			close $write;
			
		};
		POSIX::_exit(1);
		
	}
	
}


sub rblspy_pipeinput ($$$$) {
	
	# This pipes the input from our forked process to the callback with arguments
	my ($read, $ptag, $callback, $argref) = @{$_[0]};

	my @lines = <$read>;
	close $read;

	Irssi::input_remove($$ptag);
	my $result = join("", @lines);
	$result =~ s/\n//g;
	if (length($result) <= 1) { $result = ""; }
	$callback->($result, $argref);
	
}


sub rblspy_join ($$) {
	
	my ($reason, $argref) = @_;
	my ($ipaddress, $nick, $channel) = @{$argref};

	my $witem = Irssi::window_item_find($channel);	
	if (!$witem) { $witem = Irssi::active_win(); }

	$outline = "";

	# If one of the DNS resolutions return a vaild address, the following
	# conditionals use the $settings values to handle actions at the client.
	if ($reason ne "") {
		$globalline++;
		$outline = "$nick is blacklisted $ipaddress ($reason)";
		$lastmatchnick = $nick;
		$lastmatchip = $ipaddress;
		
		if ($outline ne "") { 
			# Check the last time we sent a line to the channel
			if ((time - $lasttime) >= $settings{'linedelay'}) {
				if ($settings{'autoban'} >= 1) {
					$witem->command("/kn 90 $nick blacklisted host, please msg an op");
				} else {
					if ($settings{'announce'} >= 1) {
						$witem->command("/say $outline [$globalline]");
					} else {
						$witem->print("$outline [$globalline]");
					}
				}
				
				$lasttime = time;
							
			} else {
				if ($settings{'autoban'} >= 1) { $witem->command("/kn 90 $nick"); }
				$witem->print("Delayed $outline [$globalline]");
			}
		} else {
			# Do nothing
		}
	} else {
		# Do nothing
	}
			
}


sub rblspy_set ($) {

	my ($arg) = @_;
	my @args = split(/ /, $arg);

	if ($#args >= 1) {
		if (exists($settings{$args[0]})) {
			$settings{$args[0]} = $args[1];
			Irssi::active_win->print("$args[0] set to $settings{$args[0]}");
		} else {
			Irssi::active_win->print("No such setting.");
		}
	} elsif ($#args == 0) {
		if (exists($settings{$args[0]})) {
			Irssi::active_win->print("$args[0] $settings{$args[0]}")
		} else {
			Irssi::active_win->print("No such setting.");
		}
	} else {
		foreach my $setting (keys %settings) {
			Irssi::active_win->print("$setting $settings{$setting}")
		}
	}
	
}


sub rblspy_ban {
	
	Irssi::active_win->command("/kickban $lastmatchnick blacklisted host, please msg an op.");
	
}


sub rblspy_last {
	
	if (length($lastmatchnick) > 0) {
		Irssi::active_win->print("$lastmatchnick was blacklisted.");
	} else {
		Irssi::active_win->print("No blacklisted hosts in history.");
	}	
	
}




Irssi::signal_add('message join', 'event_message_join');
Irssi::signal_add('message private', 'event_private_message');
Irssi::command_bind('rblban', 'rblspy_ban');
Irssi::command_bind('rbllast', 'rblspy_last');
Irssi::command_bind('rblset', 'rblspy_set');

